perm filename GEOMES[GEO,BGB] blob
sn#001347 filedate 1972-10-28 generic text, type T, neo UTF8
00100 α ABBREVIATIONS FOR PROCEDURE DECLARATIONS;
00200 DEFINE XISUBR= "EXTERNAL INTEGER SIMPLE PROCEDURE";
00300 DEFINE XRSUBR= "EXTERNAL REAL SIMPLE PROCEDURE";
00400 DEFINE XSUBR = "EXTERNAL SIMPLE PROCEDURE";
00500 DEFINE ISUBR = "INTEGER SIMPLE PROCEDURE";
00600 DEFINE RSUBR = "REAL SIMPLE PROCEDURE";
00700 DEFINE BSUBR = "BOOLEAN SIMPLE PROCEDURE";
00800
00900 α YE OLDE MNEMONICS;
01000 ISUBR LAC (ITG Q); START_CODE MOVE 1,@Q END;
01100 RSUBR LACR(ITG Q); START_CODE MOVE 1,@Q END;
01200 ISUBR CAR (ITG Q); START_CODE HLRZ 1,@Q END;
01300 ISUBR CDR (ITG Q); START_CODE HRRZ 1,@Q END;
01400 SUBR DAC (ITG N,Q); START_CODE MOVE N; MOVEM @Q END;
01500 SUBR DACR(REAL X;ITG Q);START_CODE MOVE X;MOVEM @Q END;
01600 SUBR DIP (ITG N,Q); START_CODE MOVE N; HRLM @Q END;
01700 SUBR DAP (ITG N,Q); START_CODE MOVE N; HRRM @Q END;
01800 ISUBR NIP (ITG Q); START_CODE HLRE 1,@Q END;
01900 ISUBR NAP (ITG Q); START_CODE HRRE 1,@Q END;
02000 DEFINE INCREM(A)="A←A+1";
02100 DEFINE DECREM(A)="A←A-1";
02200
02300 α FATAL MESSAGE;
02400 SUBR FATAL (STRING S);
02500 ⊂ OUTSTR(↓&"FATAL ERROR - "&S&↓);
02600 WHILE TRUE DO INCHRW ⊃;
02700 α UBFEV NUMBER;
02800 ISUBR ITYPE (ITG X);
02900 RETURN(CASE(CAR(X)LAND '17)OF
03000 (0,1,2,0, 3,0,0,0, 4,0,0,0, 0,0,0,0));
03100 α ENTITY TYPES;
03200 BSUBR BTYPE(ITG X); RETURN((CAR(X)LAND 1)≠0);
03300 BSUBR FTYPE(ITG X); RETURN((CAR(X)LAND 2)≠0);
03400 BSUBR ETYPE(ITG X); RETURN((CAR(X)LAND 4)≠0);
03500 BSUBR VTYPE(ITG X); RETURN((CAR(X)LAND 8)≠0);
03600 α WORLD CONTEXT;
03700 EXTERNAL ITG WORLD,BTOTAL,FTOTAL,ETOTAL,VTOTAL;
00100 α FETCH LINK FROM NODE;
00200 XISUBR PART (ITG E); XISUBR COPART(ITG E);
00300 XISUBR EXTENT(ITG E); XISUBR LOCOR (ITG E);
00400 XISUBR PNAME (ITG E); XISUBR DISK (ITG E);
00500 XISUBR TYPE (ITG E); XISUBR SERIAL(ITG E);
00600
00700 XISUBR NFACE (ITG E); XISUBR PFACE (ITG E);
00800 XISUBR NED (ITG E); XISUBR PED (ITG E);
00900 XISUBR NVT (ITG E); XISUBR PVT (ITG E);
01000
01100 XISUBR NCW (ITG E); XISUBR PCW (ITG E);
01200 XISUBR NCCW (ITG E); XISUBR PCCW (ITG E);
01300
01400 XISUBR FCNT (ITG E); XISUBR VCNT (ITG E);
01500 XISUBR ECNT (ITG E); XISUBR PCNT (ITG E);
01600 XISUBR NBODY (ITG E); XISUBR PBODY (ITG E);
01700 XISUBR NUF (ITG E); XISUBR PUF (ITG E);
01800 XISUBR NCNT (ITG E); XISUBR TJOINT(ITG E);
01900 XISUBR X1DC (ITG E); XISUBR Y1DC (ITG E);
02000 XISUBR X2DC (ITG E); XISUBR Y2DC (ITG E);
02100 XRSUBR XDC (ITG E); XRSUBR YDC (ITG E);
02200 XISUBR ALT(ITG E);
02300
02400 α STORE LINK INTO NODE;
02500 XISUBR PART. (ITG Q,E); XISUBR COPAR.(ITG Q,E);
02600 XISUBR EXTEN.(ITG Q,E); XISUBR LOCOR.(ITG Q,E);
02700 XISUBR PNAME.(ITG Q,E); XISUBR DISK. (ITG Q,E);
02800 XISUBR TYPE. (ITG Q,E); XISUBR SERIA.(ITG Q,E);
02900
03000 XISUBR NFACE.(ITG Q,E); XISUBR PFACE.(ITG Q,E);
03100 XISUBR NED. (ITG Q,E); XISUBR PED. (ITG Q,E);
03200 XISUBR NVT. (ITG Q,E); XISUBR PVT. (ITG Q,E);
03300
03400 XISUBR NCW.. (ITG Q,E); XISUBR PCW.. (ITG Q,E);
03500 XISUBR NCCW..(ITG Q,E); XISUBR PCCW..(ITG Q,E);
03600
03700 XISUBR FCNT. (ITG Q,E); XISUBR VCNT. (ITG Q,E);
03800 XISUBR ECNT. (ITG Q,E); XISUBR PCNT. (ITG Q,E);
03900 XISUBR NBODY.(ITG Q,E); XISUBR PBODY.(ITG Q,E);
04000 XISUBR NUF. (ITG Q,E); XISUBR PUF. (ITG Q,E);
04100 XISUBR NCNT. (ITG Q,E); XISUBR TJOIN.(ITG Q,E);
04200 XISUBR ALT.(ITG Q,E);
00100 α FETCH DATA FROM NODE;
00200
00300 DEFINE AA(E)="MEMORY[E-3,REAL]";
00400 DEFINE BB(E)="MEMORY[E-2,REAL]";
00500 DEFINE CC(E)="MEMORY[E-1,REAL]";
00600 DEFINE KK(F)="MEMORY[F+4,REAL]";
00700
00800 DEFINE XWC(V)="MEMORY[V-3,REAL]";
00900 DEFINE YWC(V)="MEMORY[V-2,REAL]";
01000 DEFINE ZWC(V)="MEMORY[V-1,REAL]";
01100
01200 DEFINE XPP(V)="MEMORY[V+4,REAL]";
01300 DEFINE YPP(V)="MEMORY[V+5,REAL]";
01400 DEFINE ZPP(V)="MEMORY[V+6,REAL]";
01500
01600 XRSUBR IX(ITG E); XRSUBR IY(ITG E); XRSUBR IZ(ITG E);
01700 XRSUBR JX(ITG E); XRSUBR JY(ITG E); XRSUBR JZ(ITG E);
01800 XRSUBR KX(ITG E); XRSUBR KY(ITG E); XRSUBR KZ(ITG E);
00100 α DYNAMIC FREE STORAGE;
00200 XISUBR GETBLK(ITG SIZE);
00300 XSUBR RELBLK(ITG ADDR);
00400
00500 α BFEV MAKE & KILL OPERATIONS;
00600 XISUBR MKB(ITG B); XSUBR KLB(ITG BNEW);
00700 XISUBR MKF(ITG B); XSUBR KLF(ITG B,FNEW);
00800 XISUBR MKE(ITG B); XSUBR KLE(ITG B,ENEW);
00900 XISUBR MKV(ITG B); XSUBR KLV(ITG B,VNEW);
01000 XISUBR MKBFV; XSUBR KLBFEV(ITG Q);
01100
01200 α WING MAKE LINK OPERATIONS;
01300 XSUBR WING(ITG E1,E2);
01400
01500 α ORIENTED WING FETCH & STORE OPERATIONS;
01600 XISUBR ECW(ITG E,Q); XISUBR ECW.(ITG Q,E,X);
01700 XISUBR ECCW(ITG E,Q); XISUBR ECCW.(ITG Q,E,X);
01800 XISUBR OTHER(ITG E,Q); XISUBR OTHER.(ITG Q,E,X);
01900
02000 α BFV FETCH OPERATIONS;
02100 XISUBR BODY(ITG Q); XISUBR MKPARTS(ITG B);
02200 XISUBR FCW(ITG E,V); XISUBR FCCW(ITG E,V);
02300 XISUBR VCW(ITG E,F); XISUBR VCCW(ITG E,F);
02400
02500 α EULER SURFACE OPERATIONS;
02600 XISUBR MKEV(ITG F,V);
02700 XISUBR MKFE(ITG V1,F,V2);
02800 XISUBR ESPLIT(ITG E);
02900 XISUBR KLEV(ITG VNEW);
03000 XISUBR KLVE(ITG ENEW);
03100 XISUBR KLFE(ITG ENEW);
03200 XSUBR INVERT(ITG E);
03300 XSUBR EVERT(ITG B);
03400 XISUBR LINKED(ITG Q1,Q2);
03500 XISUBR GLUEE(ITG F1,V1,F2,V2);
00100 α PARTS PRIMITIVES;
00200 XISUBR SUPART(ITG B);
00300 XSUBR ATTACH(ITG B1,B2);
00400 XSUBR DETACH(ITG B);
00500 α SOLID OPERATIONS;
00600
00700 α SOLID BOOLEAN OPERATIONS;
00800
00900 α THE FOUR EUCLIDEAN TRANSFORMATIONS;
01000 XSUBR TRANSLATE (ITG Q,R);
01100 XSUBR ROTATE (ITG Q,R);
01200 XSUBR DILATE (ITG Q,R);
01300 XSUBR REFLECT (ITG Q,R);
01400
01500 α IMAGE SYNTHESIS OPERATIONS;
01600 XISUBR MKLOCOR;
01700 XSUBR BLIT(ITG B,A,N);
01800 XSUBR PROJECTOR (ITG CAMERA,ALBODY);
01900 XSUBR FMARK(ITG ALBODY);
02000 XSUBR EMARK(ITG ALBODY);
02100 XSUBR EMARKALL(ITG ALBODY);
02200 XISUBR CLIPER (ITG WINDOW,ALBODY);
02300 α IMAGE ANALYSIS OPERATIONS;
00100 α RING OPERATIONS;
00200 XSUBR RINGIN(ITG E,Q,N);
00300 XSUBR RINGO(ITG E,N);
00400 XISUBR EMPTY(ITG E,N);
00500
00600 α RING POSITION NUMBERS; DEFINE
00700 #QRING = "-1",
00800 #LDX = "1", #XL = "1",
00900 #LDY = "2", #XH = "2",
01000 #LDZ = "3", #YL = "3",
01100 #PDX = "4", #YH = "4",
01200 #PDY = "5",
01300 #FOCAL = "6", #ALBODY = "6",
01400 #OX = "5",
01500 #OY = "6",
01600 #DX = "7", #MAGX = "7",
01700 #DY = "8", #MAGY = "8",
01800 #CAMERA = "-4",
01900 #LOCOR = "-3",
02000 #XSCALE = "7",
02100 #YSCALE = "8",
02200 #ZSCALE = "9",
02300 #SOX="-2",
02400 #SOY="-1";